Windows Game Programming for Dummies (2nd Edition)/WinGamProgFD.iso/pc/DirectX SDK/DXSDK/samples/Multimedia/VBSamples/DirectMusic/DMDrums/main.frm

Visual Basic Form | 2001-10-08 | 18.6 KB | 592 lines

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form main
   BorderStyle     =   1  'Fixed Single
   Caption         =   "DMDrums"
   ClientHeight    =   5505
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6255
   Icon            =   "main.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5505
   ScaleWidth      =   6255
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkReverb
      Caption         =   "Play with environmental reverb"
      Height          =   255
      Left            =   1140
      TabIndex        =   39
      Top             =   1500
      Value           =   1  'Checked
      Width           =   3015
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "Exit"
      Height          =   495
      Left            =   5340
      TabIndex        =   31
      Top             =   4980
      Width           =   855
   End
   Begin MSComCtl2.UpDown UpDown_Volume
      Height          =   375
      Left            =   1740
      TabIndex        =   36
      TabStop         =   0   'False
      Top             =   960
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   661
      _Version        =   393216
      Value           =   100
      Max             =   100
      Enabled         =   -1  'True
   End
   Begin MSComCtl2.UpDown UpDown_Tempo
      Height          =   375
      Left            =   1740
      TabIndex        =   35
      TabStop         =   0   'False
      Top             =   360
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   661
      _Version        =   393216
      Value           =   120
      Max             =   1000
      Min             =   1
      Enabled         =   -1  'True
   End
   Begin VB.TextBox EDIT_Tempo
      Height          =   375
      Left            =   1200
      MaxLength       =   4
      TabIndex        =   0
      Text            =   "120"
      Top             =   360
      Width           =   495
   End
   Begin VB.TextBox EDIT_Volume
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Text            =   "100"
      Top             =   960
      Width           =   495
   End
   Begin VB.CommandButton Stop
      Height          =   495
      Left            =   3720
      Picture         =   "main.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   840
      Width           =   495
   End
   Begin VB.CommandButton Play
      Height          =   495
      Left            =   3120
      Picture         =   "main.frx":08F8
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   840
      Width           =   495
   End
   Begin VB.PictureBox Picture1
      BorderStyle     =   0  'None
      Height          =   1695
      Left            =   120
      Picture         =   "main.frx":0E8A
      ScaleHeight     =   1695
      ScaleWidth      =   855
      TabIndex        =   32
      TabStop         =   0   'False
      Top             =   120
      Width           =   855
   End
   Begin VB.ListBox LIST_Grooves
      Height          =   2400
      Left            =   4320
      TabIndex        =   29
      Top             =   840
      Width           =   1815
   End
   Begin VB.ListBox LIST_Bands
      Height          =   1425
      Left            =   4320
      TabIndex        =   30
      Top             =   3480
      Width           =   1815
   End
   Begin VB.CommandButton Drum
      Caption         =   "High Q"
      Height          =   495
      Index           =   24
      Left            =   3480
      TabIndex        =   28
      Top             =   4440
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Scratch"
      Height          =   495
      Index           =   23
      Left            =   2640
      TabIndex        =   27
      Top             =   4440
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Sticks"
      Height          =   495
      Index           =   22
      Left            =   1800
      TabIndex        =   26
      Top             =   4440
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Hand Clap"
      Height          =   495
      Index           =   21
      Left            =   960
      TabIndex        =   25
      Top             =   4440
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Tamb- ourine"
      Height          =   495
      Index           =   20
      Left            =   120
      TabIndex        =   24
      Top             =   4440
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Jingle Bells"
      Height          =   495
      Index           =   19
      Left            =   3480
      TabIndex        =   23
      Top             =   3840
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Cast- anets"
      Height          =   495
      Index           =   18
      Left            =   2640
      TabIndex        =   22
      Top             =   3840
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Shaker"
      Height          =   495
      Index           =   17
      Left            =   1800
      TabIndex        =   21
      Top             =   3840
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Triangle"
      Height          =   495
      Index           =   16
      Left            =   960
      TabIndex        =   20
      Top             =   3840
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Cuica"
      Height          =   495
      Index           =   15
      Left            =   120
      TabIndex        =   19
      Top             =   3840
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "High Block"
      Height          =   495
      Index           =   14
      Left            =   3480
      TabIndex        =   18
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Low Block"
      Height          =   495
      Index           =   13
      Left            =   2640
      TabIndex        =   17
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Guiro"
      Height          =   495
      Index           =   12
      Left            =   1800
      TabIndex        =   16
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Agogo"
      Height          =   495
      Index           =   11
      Left            =   960
      TabIndex        =   15
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Timbale"
      Height          =   495
      Index           =   10
      Left            =   120
      TabIndex        =   14
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "High Conga"
      Height          =   495
      Index           =   9
      Left            =   3480
      TabIndex        =   13
      Top             =   2640
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Low Conga"
      Height          =   495
      Index           =   8
      Left            =   2640
      TabIndex        =   12
      Top             =   2640
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Crash"
      Height          =   495
      Index           =   7
      Left            =   1800
      TabIndex        =   11
      Top             =   2640
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Splash"
      Height          =   495
      Index           =   6
      Left            =   960
      TabIndex        =   10
      Top             =   2640
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Ride"
      Height          =   495
      Index           =   5
      Left            =   120
      TabIndex        =   9
      Top             =   2640
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "High Tom"
      Height          =   495
      Index           =   4
      Left            =   3480
      TabIndex        =   8
      Top             =   2040
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Mid Tom"
      Height          =   495
      Index           =   3
      Left            =   2640
      TabIndex        =   7
      Top             =   2040
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Low Tom"
      Height          =   495
      Index           =   2
      Left            =   1800
      TabIndex        =   6
      Top             =   2040
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Snare"
      Height          =   495
      Index           =   1
      Left            =   960
      TabIndex        =   5
      Top             =   2040
      Width           =   735
   End
   Begin VB.CommandButton Drum
      Caption         =   "Kick"
      Height          =   495
      Index           =   0
      Left            =   120
      TabIndex        =   4
      Top             =   2040
      Width           =   735
   End
   Begin VB.Label lblInfo
      BackStyle       =   0  'Transparent
      Caption         =   "Drum Sets"
      Height          =   255
      Index           =   1
      Left            =   4320
      TabIndex        =   38
      Top             =   3240
      Width           =   1755
   End
   Begin VB.Label lblInfo
      BackStyle       =   0  'Transparent
      Caption         =   "Grooves"
      Height          =   255
      Index           =   0
      Left            =   4320
      TabIndex        =   37
      Top             =   600
      Width           =   1755
   End
   Begin VB.Label Label2
      Caption         =   "Tempo:"
      Height          =   255
      Left            =   1200
      TabIndex        =   34
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label1
      Caption         =   "Volume:"
      Height          =   255
      Left            =   1200
      TabIndex        =   33
      Top             =   720
      Width           =   615
   End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
'  File:       main.frm
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim dx As New DirectX8
Dim perf As DirectMusicPerformance8
Dim loader As DirectMusicLoader8
Dim style As DirectMusicStyle8
Dim band As DirectMusicBand8
Dim composer As DirectMusicComposer8
Dim seg As DirectMusicSegment8
Dim segBand As DirectMusicSegment8
Dim segMotif() As DirectMusicSegment8
Dim mediapath As String
Dim mtTime As Long
Private Sub chkReverb_Click()
    'Ok, they want to switch the default audio paths
    Dim dmPath As DirectMusicAudioPath8
    If chkReverb.Value = vbUnchecked Then
        Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_DYNAMIC_STEREO, 128, True)
    Else
        Set dmPath = perf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True)
    End If
    perf.SetDefaultAudioPath dmPath
    ChangeBands
End Sub
Private Sub cmdExit_Click()
    Stop_Click
    Unload Me
End Sub
Private Sub Drum_Click(Index As Integer)
    Call perf.PlaySegmentEx(segMotif(Index), DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub EDIT_Tempo_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
            UpDown_Tempo.Value = EDIT_Tempo.Text
            ChangeTempo (UpDown_Tempo.Value)
        Else
            EDIT_Tempo.Text = UpDown_Tempo.Value
        End If
    End If
    If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Tempo_LostFocus()
    If Val(EDIT_Tempo.Text) > 0 And Val(EDIT_Tempo.Text) < 1001 And IsNumeric(EDIT_Tempo.Text) Then
        UpDown_Tempo.Value = EDIT_Tempo.Text
        ChangeTempo (UpDown_Tempo.Value)
    Else
        EDIT_Tempo.Text = UpDown_Tempo.Value
    End If
End Sub
Private Sub EDIT_Volume_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
            UpDown_Volume.Value = EDIT_Volume.Text
            ChangeVolume UpDown_Volume.Value
        Else
            EDIT_Volume.Text = UpDown_Volume.Value
        End If
    End If
    If KeyAscii = vbKeyReturn Then KeyAscii = 0
End Sub
Private Sub EDIT_Volume_LostFocus()
    If IsNumeric(EDIT_Volume.Text) And Val(EDIT_Volume.Text) >= 0 And Val(EDIT_Volume.Text) < 101 Then
        UpDown_Volume.Value = EDIT_Volume.Text
        ChangeVolume UpDown_Volume
    Else
        EDIT_Volume.Text = UpDown_Volume.Value
    End If
End Sub
Private Sub Form_Load()
    Dim dmA As DMUS_AUDIOPARAMS, lCount As Long
    Dim MotifName As String
    mediapath = FindMediaDir("Drums!.sgt")
    Set perf = dx.DirectMusicPerformanceCreate()
    Set loader = dx.DirectMusicLoaderCreate()
    Set composer = dx.DirectMusicComposerCreate()
    'Make sure we can init the audio as well
    On Error GoTo FailedInit
    ' Initialize performance object to use its own DirectSound object
    perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
    ' SetMasterAutoDownload indicates we the perofmance object
    ' to attempt to auto download DLS collections when reference in
    ' sgt and sty files
    Call perf.SetMasterAutoDownload(True)
    Set style = loader.LoadStyle(mediapath & "drums!.sty")
    Set seg = loader.LoadSegment(mediapath & "drums!.sgt")
    Get_Bands
    LIST_Grooves.AddItem ("Alternative")
    LIST_Grooves.AddItem ("Blues")
    LIST_Grooves.AddItem ("Country")
    LIST_Grooves.AddItem ("Dance - Pop")
    LIST_Grooves.AddItem ("Hard Rock")
    LIST_Grooves.AddItem ("Hip Hop")
    LIST_Grooves.AddItem ("Jazz")
    LIST_Grooves.AddItem ("Latin")
    LIST_Grooves.AddItem ("R & B")
    LIST_Grooves.AddItem ("Rap")
    LIST_Grooves.AddItem ("Soft Rock")
    LIST_Grooves.AddItem ("World")
    ' Download the default band so that we can play the drum pads immediately
    ChangeBands
    ChangeVolume UpDown_Volume.Value
    ReDim segMotif(style.GetMotifCount() - 1)
    For lCount = 0 To style.GetMotifCount() - 1
        MotifName = style.GetMotifName(lCount)
        'We could set the drum name here (but we'll just leave them hard coded)
        'Drum(lCount).Caption = MotifName
        Set segMotif(lCount) = style.GetMotif(MotifName)
    Next
    LIST_Grooves.ListIndex = 0
    LIST_Bands.ListIndex = 0
    Exit Sub
FailedInit:
    MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim lCount As Long
    On Error Resume Next
    If Not (segBand Is Nothing) Then
        perf.StopEx segBand, 0, 0
        segBand.Unload perf.GetDefaultAudioPath
    End If
    If Not (seg Is Nothing) Then perf.StopEx seg, 0, 0
    Set seg = Nothing
    For lCount = LBound(segMotif) To UBound(segMotif)
        If Not (segMotif(lCount) Is Nothing) Then perf.StopEx segMotif(lCount), 0, 0
        Set segMotif(lCount) = Nothing
    Next
    Set segBand = Nothing
    Set style = Nothing
    Set composer = Nothing
    Set loader = Nothing
    If Not (band Is Nothing) Then
        Call band.Unload(perf)
    End If
    Set band = Nothing
    If Not (perf Is Nothing) Then perf.CloseDown
    Set perf = Nothing
End Sub
Private Sub Get_Bands()
    Dim BandCount As Integer
    Dim counter As Integer
    BandCount = style.GetBandCount()
    For counter = 0 To (BandCount - 1)
        LIST_Bands.AddItem (style.GetBandName(BandCount - counter - 1))
    Next counter
End Sub
Private Sub LIST_Bands_Click()
    ChangeBands
End Sub
Private Sub LIST_Grooves_Click()
    perf.SetMasterGrooveLevel ((LIST_Grooves.ListIndex * 8) + 1)
End Sub
Private Sub Play_Click()
    PlaySeg
    ChangeBands
    chkReverb.Enabled = False
End Sub
Private Sub Stop_Click()
    perf.StopEx seg, 0, 0
    chkReverb.Enabled = True
End Sub
Private Sub UPDOWN_Tempo_Change()
    EDIT_Tempo.Text = UpDown_Tempo.Value
    ChangeTempo (UpDown_Tempo.Value)
End Sub
Private Sub UPDOWN_Volume_Change()
    EDIT_Volume.Text = UpDown_Volume.Value
    Call ChangeVolume(UpDown_Volume.Value)
End Sub
Private Sub ChangeBands()
    If Not (band Is Nothing) Then
        Call band.Unload(perf)
    End If
    If LIST_Bands = vbNullString Then
        Set band = style.GetBand("Standard")
    Else
        Set band = style.GetBand(LIST_Bands)
    End If
    Call band.Download(perf)
    Set segBand = band.CreateSegment()
    segBand.Download perf.GetDefaultAudioPath
    Call perf.PlaySegmentEx(segBand, DMUS_SEGF_SECONDARY, 0)
End Sub
Private Sub PlaySeg()
    Call perf.PlaySegmentEx(seg, 0, 0)
End Sub
Private Sub ChangeTempo(tempo As Integer)
    perf.SendTempoPMSG 0, DMUS_PMSGF_REFTIME, tempo
End Sub
Sub ChangeVolume(ByVal n As Long)
    If n = 0 Then
        n = -10000
    Else
        n = (-50 * (100 - n))
    End If
    perf.SetMasterVolume n
End Sub